home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu295.dms / pu295.adf / Logging / CQWWLog / CQWWLOG.BAS < prev    next >
BASIC Source File  |  1988-12-18  |  18KB  |  532 lines
  1. ' CQWWLOG.BAS version 1.2
  2. ' Copyright © 1986,1987 by Clarke Greene K1JX (NOT FOR COMMERCIAL USE)
  3. ' Amiga Version by John Gager K7KB 
  4. '
  5. ' This Microsoft (tm) BASIC program will build a complete log package
  6. ' for the CQ Worldwide DX Contest.
  7. '
  8. ' The file containing the log entries must be an ASCII file in the
  9. ' following format:
  10. ' 
  11. '             (each band requires a separate log entry file)
  12. '
  13. ' TIME         CALLSIGN            RCV'D REPORT  (each log entry must
  14. '                                                 be followed by a
  15. '                                                 carriage return)
  16. '
  17. ' At least one space must be between each field of each log entry. Only
  18. ' a changed digit in the TIME field must be present; for example, If
  19. ' the contest begins at 1800Z and the first contact is made at 1802Z 
  20. ' and the second contact is made at 1805Z, then only 5 need be entered
  21. ' in the TIME field. IF the third contact is made at 1812 Z, then 12 
  22. ' should be entered in the TIME field. IF the next contact is made at 
  23. ' 1812 Z, then no number need be entered in the TIME field (however, be
  24. ' sure to enter a space to indicate separation between fields)!
  25. '
  26. ' These files will be produced:
  27. '
  28. ' <filename>.LOG - this is a complete log ready for printing
  29. ' <filename>.DUP - this is a sorted duplicate listing ready for printing
  30. ' <filename>.SUM - this is a summary sheet ready for printing
  31. '
  32. '
  33. ' Depending on the version of BASIC for your particular machine, the
  34. ' CLS (Clear Screen) command must be changed.  Consult your own 
  35. ' computer's BASIC documentation for more information.
  36. '
  37. '
  38. ' If compiling (a VERY good idea for several orders of magnitude
  39. ' improvement in speed), use O and E switches 
  40. '
  41. ' This program also uses a prefix library file (DXPREFIX.LIB), which
  42. ' MUST be on the same disc (and in the same subdirectory) as this
  43. ' program.
  44. '
  45. '  Define arrays and variables
  46. '
  47. CLEAR ,80000& : DEFINT a-Z : OPTION BASE 1
  48. DIM ENTRY$(1500), MULT$(175), PFX$(1000), CTRY$(1000), CNT$(1000), WIERDPFX$(50), WIERDCTRY$(50), WIERDCNT$(50), AMBCTRY$(10)
  49. DIM Q(175), ZONE(40)
  50. BLANK$=" " : BL$="" : SLANT$="/" : TRUE=-1
  51. DUPE1$="  - Duplica" : DUPE2$="te QSO -"
  52. '
  53. '  Define format strings for printouts
  54. '
  55. LOGFORM$=" \      \  \  \   \           \   \   \   \   \   \         \\           \  #"
  56. DUPFORM$="     \          \   \          \   \          \   \          \   \          \"
  57. SUMFORM$="     \          \   \          \   \          \   \          \   \          \"
  58. FOOTFORM$=" ##         ##          ##        ###"
  59. '
  60. CLS
  61. COLOR 3 : PRINT TAB(26) "CQWW DX Contest Log Processor" : COLOR 1
  62. PRINT : PRINT
  63. '
  64. '  Read Prefix table file
  65. '
  66. PRINT TAB(5)  "Reading prefix library...";
  67. I=0 ' initialize array subscript
  68. OPEN ":DXPREFIX.LIB" FOR INPUT AS #1
  69. WHILE NOT EOF(1)
  70.   I=I+1
  71.   INPUT #1, PFX$(I), DUMMY$, CTRY$(I), CNT$(I) ' DUMMT$ is a dummy
  72.                                                ' variable FOR DATA not
  73.                                                ' used
  74. WEND
  75. CLOSE
  76. TABLESIZE=I ' prefix table length
  77. COLOR 3 : PRINT "Done" : COLOR 1
  78. '
  79. '  Get user input
  80. '
  81. PRINT : PRINT TAB(5) "What is the station callsign?  ";
  82. INPUT "", MYCALL$ : MYCALL$=UCASE$(MYCALL$)
  83. THISENTRY$=MYCALL$ : IF INSTR(THISENTRY$,SLANT$)>0 THEN GOSUB GetPortPrefix ELSE THISPFX$=LEFT$(THISENTRY$,4)
  84. GOSUB SearchPrefix : IF NOT INLIST THEN GOSUB SearchWierd
  85. MYCTRY$=THISCTRY$ : MYCNT$=THISCNT$ : IF MYCNT$="NA" THEN MYCNTPTS=2 ELSE MYCNTPTS=1
  86.  
  87. ZoneEntry:
  88.  
  89. PRINT : PRINT TAB(5) "What is the station's WAZ zone?  ";
  90. INPUT "", MYZONE$
  91. IF VAL(MYZONE$)<1 OR VAL(MYZONE$)>40 THEN PRINT CHR$(7);: GOTO ZoneEntry
  92. IF VAL(MYZONE$)<10 AND LEN(MYZONE$)=1 THEN MYZONE$="0"+MYZONE$
  93. PRINT : PRINT TAB(5) "What is the beginning date of the contest ";
  94. COLOR 3 : PRINT"<DD/MM/YY>";:COLOR 1:PRINT"?  ";
  95. INPUT "", STARTDATE$
  96. MARK=INSTR(STARTDATE$,"/") : IF MARK=0 THEN MARK=INSTR(STARTDATE$,"-")
  97. STARTDAY=VAL(LEFT$(STARTDATE$,MARK-1))
  98. STARTDATE$=RIGHT$(STARTDATE$,LEN(STARTDATE$)-MARK)
  99. MARK=INSTR(STARTDATE$,"/") : IF MARK=0 THEN MARK=INSTR(STARTDATE$,"-")
  100. MON=VAL(LEFT$(STARTDATE$,MARK-1))
  101. IF MON=10 THEN MON$=" Oct.  " : RST$="59" ELSE MON$=" Nov.  " : RST$="599"
  102. SENT$=RST$+MYZONE$
  103. yr$=RIGHT$(STARTDATE$,LEN(STARTDATE$)-MARK)
  104. PRINT : PRINT TAB(5) "What is the GMT starting time for the contest?  ";
  105. INPUT "", STARTGMT$
  106. PRINT : PRINT TAB(5) "What file is the log extract located in?  ";
  107. INPUT "", INFILE$ : GOSUB CheckForFile ' check to see if file is valid
  108. IF INSTR(INFILE$,".")<>0 THEN OUTFILE$=LEFT$(INFILE$,INSTR(INFILE$,".")-1) ELSE OUTFILE$=INFILE$
  109. PRINT : PRINT TAB(5) "What frequency band is the log extract for?  ";
  110. INPUT "", BAND$
  111. '
  112. '  Build log file
  113. '
  114. CLS
  115. PRINT : PRINT TAB(5) "Duping and counting...";
  116. '
  117. '  Clear arrays
  118. '
  119. FOR I=1 TO 1500
  120.   ENTRY$(I)=BL$
  121. NEXT I
  122. FOR I=1 TO 175
  123.   MULT$(I)=BL$
  124.   Q(I)=1
  125. NEXT I
  126. FOR I=1 TO 40
  127.   ZONE(I)=0
  128. NEXT I
  129. '
  130. '  Initialize variables
  131. '
  132. RAWTOTAL=0 : QSOS=0 : DUPES=0 : CTRYNR=0 : ZONENR=0 : TOTPOINTS=0
  133. PGQSOS=0 : PGZONES=0 : PGCTRY=0 : PGPTS=0
  134. DAY=STARTDAY : PREVIOUSGMT$=STARTGMT$
  135. '
  136. '  Open input file and output .LOG file
  137. '
  138. OPEN INFILE$ FOR INPUT AS #1 LEN=5000
  139. OPEN OUTFILE$+".LOG" FOR OUTPUT AS #2 LEN=5000
  140. '
  141. '  Input data, process, and enter into output file
  142. '
  143. WHILE NOT EOF(1)
  144.   LINE INPUT #1, THISENTRY$ ' read entire line from disc file
  145.   IF LEN(THISENTRY$)=0 THEN SkipEntry
  146.   WHILE ASC(RIGHT$(THISENTRY$,1))<48 AND LEN(THISENTRY$)>0
  147.     THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1) ' strip off trailing
  148.                                                    ' spaces, etc.
  149.   WEND
  150.   IF LEN(THISENTRY$)>0 THEN RAWTOTAL=RAWTOTAL+1 ELSE GOTO SkipEntry
  151.   '
  152.   '  Separate received report from THISENTRY$
  153.   '
  154.   RCVD$=BL$ ' initialize RCVD$ to be null string
  155.   WHILE ASC(RIGHT$(THISENTRY$,1))>=48
  156.     RCVD$=RIGHT$(THISENTRY$,1)+RCVD$
  157.     THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1) ' parse last character
  158.                                                    ' of string
  159.   WEND
  160.   IF LEN(RCVD$)<=2 THEN RCVD$=RST$+RCVD$ ' if no RST was typed, append
  161.                                          ' standard report
  162.   IF LEN(RCVD$)<(LEN(RST$)+2) THEN RCVD$=LEFT$(RCVD$,LEN(RST$))+"0"+RIGHT$(RCVD$,1)
  163.   WHILE ASC(RIGHT$(THISENTRY$,1))<48
  164.     THISENTRY$=LEFT$(THISENTRY$,LEN(THISENTRY$)-1) ' strip off trailing
  165.                                                    ' spaces, etc.
  166.   WEND
  167.   '
  168.   '  Separate GMT from THISENTRY$
  169.   '
  170.   WHILE ASC(LEFT$(THISENTRY$,1))<48
  171.     THISENTRY$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-1) ' strip off leading
  172.                                                     ' spaces
  173.   WEND
  174.   IF INSTR(THISENTRY$,BLANK$)<>0 THEN GMT$=LEFT$(THISENTRY$,INSTR(THISENTRY$,BLANK$)-1) ELSE GMT$=BL$
  175.   THISENTRY$=RIGHT$(THISENTRY$,(LEN(THISENTRY$)-LEN(GMT$)))
  176.   WHILE LEFT$(THISENTRY$,1)=BLANK$
  177.     THISENTRY$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-1) ' strip off leading 
  178.                                                     ' spaces
  179.   WEND
  180.   '
  181.   '  Fill in missing time data 
  182.   '
  183.   GMT$=LEFT$(PREVIOUSGMT$,(4-LEN(GMT$)))+GMT$
  184.   THEDATE$=BL$ : IF GMT$<PREVIOUSGMT$ THEN DAY=DAY+1 : THEDATE$=STR$(DAY)+MON$
  185.  
  186.   THISENTRY$=UCASE$(THISENTRY$)
  187.   '
  188.   '  Check for dupes
  189.   '
  190.   DUPE.QSO=NOT TRUE : points=3
  191.   FOR J=1 TO QSOS
  192.     IF LEN(ENTRY$(J))<>LEN(THISENTRY$) GOTO NextDupe
  193.     IF ENTRY$(J)=THISENTRY$ THEN NEWZONE$=DUPE1$ : NEWCTRY$=DUPE2$ : DUPES=DUPES+1 : points=0 : DUPE.QSO=TRUE : J=QSOS
  194.   NextDupe: NEXT J
  195.   IF DUPE.QSO GOTO WriteEntry ' skip over prefix search if this entry is a dupe
  196.   QSOS=QSOS+1 : ENTRY$(QSOS)=THISENTRY$
  197.   '
  198.   '  Determine zone and search zone table for new multiplier
  199.   '
  200.   NEWZONE$=BL$
  201.   THISZONE$=RIGHT$(RCVD$,2)
  202.   J=VAL(THISZONE$) : IF J<1 OR J>40 THEN GOSUB BadZone
  203.   IF ZONE(J)=0 THEN ZONENR=ZONENR+1 : NEWZONE$="Zone #"+STR$(ZONENR) : PGZONES=PGZONES+1
  204.   ZONE(J)=ZONE(J)+1
  205.   '
  206.   '  Determine prefix and search prefix library for contact country and continent
  207.   '
  208.   IF INSTR(THISENTRY$,SLANT$)>0 THEN GOSUB GetPortPrefix ELSE THISPFX$=LEFT$(THISENTRY$,4)
  209.   GOSUB SearchPrefix
  210.   IF NOT INLIST THEN
  211.     GOSUB SearchWierd
  212.     CLS:PRINT:PRINT TAB(5) "Back to duping and counting...";
  213.   END IF
  214.   IF ASC(THISCTRY$)<48 THEN GOSUB ResolvePrefix ' resolve ambiguous
  215.                                                 ' prefix
  216.   '
  217.   '  Search multiplier table for new country
  218.   '
  219.   NEWMULT=TRUE : NEWCTRY$=BL$
  220.   FOR J=1 TO CTRYNR
  221.     IF MULT$(J)=THISCTRY$ THEN Q(J)=Q(J)+1 : NEWMULT=NOT TRUE : J=CTRYNR
  222.   NEXT J
  223.   IF NEWMULT THEN CTRYNR=CTRYNR+1 : MULT$(CTRYNR)=THISCTRY$ : NEWCTRY$=THISCTRY$+" #"+STR$(CTRYNR) : PGCTRY=PGCTRY+1
  224.   '
  225.   '  Determine point value for QSO
  226.   '
  227.   IF THISCTRY$=MYCTRY$ THEN points=0 : GOTO UpdatePage
  228.                                                  ' contacts in your own
  229.                                                  ' country are worth 0
  230.                                                  ' points
  231.   IF THISCNT$=MYCNT$ THEN points=MYCNTPTS
  232.   '
  233.   '  Update page totals
  234.   '
  235.   UpdatePage:
  236.   
  237.   PGQSOS=PGQSOS+1 : PGPTS=PGPTS+points
  238.   TOTPOINTS=TOTPOINTS+points
  239.   '
  240.   '  Write entry to file
  241.   '
  242.   WriteEntry:
  243.     
  244.   IF (RAWTOTAL-1) MOD 50=0 THEN GOSUB PrintHeader ' print header if this
  245.                                                   ' is the beginning of
  246.                                                   ' a page
  247.   PRINT #2, USING LOGFORM$; THEDATE$; GMT$; THISENTRY$; SENT$; RCVD$; NEWZONE$; NEWCTRY$; points
  248.   IF RAWTOTAL MOD 50=0 THEN GOSUB PrintFooter ' print footer if this is the
  249.                                               ' END of a page
  250.   PREVIOUSGMT$=GMT$ : GMT$=BL$
  251.  
  252. SkipEntry:
  253. WEND
  254. GOSUB PrintFooter
  255. IF RAWTOTAL MOD 50<>0 THEN PRINT#2, CHR$(12) ' if form feed hasn't been
  256.                                              ' printed, PRINT one now
  257. CLOSE
  258. COLOR 3 : PRINT "Done" : COLOR 1
  259. '
  260. '  Build dupe sheet
  261. '
  262. PRINT : PRINT TAB(5) "Preparing dupe sheet...";
  263. '
  264. '  Sort callsigns for dupe sheet
  265. '
  266. M=QSOS\2
  267. WHILE M>0
  268.   FOR I=M+1 TO QSOS
  269.     J=I-M
  270.       WHILE J>0
  271.         IF ENTRY$(J)>ENTRY$(J+M) THEN SWAP ENTRY$(J),ENTRY$(J+M) : J=J-M ELSE J=0
  272.       WEND
  273.   NEXT I
  274.   M=M\2
  275. WEND
  276. '
  277. '  Enter dupe sheet into file
  278. '
  279. OPEN OUTFILE$+".DUP" FOR OUTPUT AS #1
  280. IF QSOS MOD 250=0 THEN LASTPAGE=QSOS\250 ELSE LASTPAGE=QSOS\250+1
  281. FOR page=1 TO LASTPAGE
  282.   PRINT #1, SPC(20-(LEN(MYCALL$)+LEN(BAND$))/2); MYCALL$; " -- Dupe Sheet for ";
  283.   PRINT #1, BAND$; " MHz Band -- Page"; STR$(page)
  284.   PRINT #1, BL$ : PRINT #1, BL$
  285.   FOR ROW=1 TO 50
  286.     E=(page-1)*250+ROW
  287.     PRINT #1, USING DUPFORM$; ENTRY$(E); ENTRY$(E+50); ENTRY$(E+100); ENTRY$(E+150); ENTRY$(E+200)
  288.   NEXT ROW
  289.   PRINT #1, CHR$(12) ' go to next page
  290. NEXT page
  291. CLOSE
  292. COLOR 3 : PRINT "Done" : COLOR 1
  293. '
  294. '  Build summary listing
  295. '
  296. PRINT : PRINT TAB(5) "Preparing summary sheet...";
  297. '
  298. '  Sort countries for summary sheet
  299. '
  300. M=CTRYNR\2
  301. WHILE M>0
  302.   FOR I=M+1 TO CTRYNR
  303.     J=I-M
  304.     WHILE J>0
  305.       IF MULT$(J)>MULT$(J+M) THEN SWAP MULT$(J),MULT$(J+M) : SWAP Q(J),Q(J+M) : J=J-M ELSE J=0
  306.     WEND
  307.   NEXT I
  308.   M=M\2
  309. WEND
  310. '
  311. '  Append number of qsos per country onto country prefixes
  312. '
  313. FOR I=1 TO CTRYNR
  314.   MULT$(I)=MULT$(I)+SPACE$(6-LEN(MULT$(I)))+" -"+STR$(Q(I))
  315. NEXT I
  316. '
  317. '  Enter country listing into file
  318. OPEN OUTFILE$+".SUM" FOR OUTPUT AS #1
  319. PRINT #1, SPC(12-(LEN(MYCALL$)+LEN(BAND$))/2); MYCALL$; " -- Summary Sheet for "; BAND$;
  320. PRINT #1, " MHz Band - "; yr$; " CQWW DX Contest" 
  321. PRINT #1, BL$
  322. PRINT #1, TAB(15); "Country Listing and number of contacts per Country"
  323. PRINT #1, BL$ : PRINT #1, BL$
  324. IF CTRYNR MOD 5=0 THEN LASTROW=CTRYNR\5 ELSE LASTROW=CTRYNR\5+1
  325. FOR ROW=1 TO LASTROW
  326.   PRINT #1, USING SUMFORM$; MULT$(ROW); MULT$(ROW+LASTROW); MULT$(ROW+LASTROW*2); MULT$(ROW+LASTROW*3); MULT$(ROW+LASTROW*4)
  327. NEXT ROW
  328. '
  329. '  Build listing of zones worked and contacts per zone
  330. '
  331. J=0
  332. FOR I=1 TO 40
  333.   IF ZONE(I)>0 THEN J=J+1 : MULT$(J)="Zone"+STR$(I)+" -"+STR$(ZONE(I))
  334. NEXT I ' put zone count into array
  335. FOR I=J TO 40
  336.   MULT$(I)=BL$
  337. NEXT I ' blank out remainder of array
  338. '
  339. '  Enter zone listing
  340. '
  341. PRINT #1, BL$ 
  342. PRINT #1, TAB(18); "Zone Listing and number of contacts per Zone"
  343. PRINT #1, BL$ 
  344. IF ZONENR MOD 5=0 THEN LASTROW=ZONENR\5 ELSE LASTROW=ZONENR\5+1
  345. FOR ROW=1 TO LASTROW
  346.   PRINT #1, USING SUMFORM$; MULT$(ROW); MULT$(ROW+LASTROW); MULT$(ROW+LASTROW*2); MULT$(ROW+LASTROW*3); MULT$(ROW+LASTROW*4)
  347. NEXT ROW
  348. '
  349. '  Enter summary into file
  350. '
  351. PRINT #1, BL$ : PRINT #1, BL$
  352. PRINT #1, "     Total Valid QSOs - "; STR$(QSOS); "       Dupes - "; STR$(DUPES)
  353. PRINT #1, "     QSO points - "; STR$(TOTPOINTS)
  354. PRINT #1, "     Zones - "; STR$(ZONENR)
  355. PRINT #1, "     Countries - "; STR$(CTRYNR)
  356. CLOSE
  357. COLOR 3 : PRINT "Done" : COLOR 1
  358. '
  359. '  Print results
  360. '
  361. CLS : PRINT CHR$(7)
  362. PRINT : PRINT TAB(5) "Results for the "; BAND$; " MHz band":PRINT 
  363. PRINT TAB(8) "Valid QSOs:";:COLOR 3:PRINT USING"       ####";QSOS:COLOR 1
  364. PRINT TAB(8) "Duplicate QSOs:";:COLOR 3:PRINT USING"     ##";DUPES:COLOR 1
  365. PRINT TAB(8) "QSO points:";:COLOR 3:PRINT USING"    ######,";TOTPOINTS:COLOR 1
  366. PRINT TAB(8) "Zones:";:COLOR 3:PRINT USING"              ##";ZONENR:COLOR 1
  367. PRINT TAB(8) "Countries:";:COLOR 3:PRINT USING"         ###";CTRYNR:COLOR 1
  368. PRINT : PRINT : PRINT 
  369. PRINT TAB(5) "Type ";:COLOR 3:PRINT"C";:COLOR 1
  370. PRINT" to continue with another band,"
  371. PRINT TAB(5) "or any other key to Exit";
  372. ANS$=INPUT$(1)
  373. IF UCASE$(ANS$)="C" THEN CLS : GOTO GetLog ELSE CLS : END
  374. '
  375. '  Subroutine to trap missing file
  376. '
  377. CheckForFile:
  378.  
  379. ON ERROR GOTO Nofile
  380. OPEN INFILE$ FOR INPUT AS #1 ' try opening file
  381. ON ERROR GOTO 0
  382. CLOSE
  383. RETURN
  384.  
  385. Nofile:
  386.  
  387. PRINT CHR$(7) : PRINT TAB(4) "That file does not exist - type X to Exit or any other key to continue ";
  388. ANS$=INPUT$(1) : IF ANS$="X" OR ANS$="x" THEN CLS : SYSTEM
  389. PRINT 
  390. RESUME GetLog
  391. '
  392. '  Subroutine to clear up impossible zone number
  393. '
  394. BadZone:
  395. CLS
  396. PRINT CHR$(7) : PRINT
  397. PRINT TAB(5) "The zone for ";:COLOR 3:PRINT THISENTRY$;
  398. PRINT" ["; THISZONE$; "]";:COLOR 1:PRINT" must be incorrect."
  399. PRINT : PRINT TAB(8) "What is the correct zone number?  "; 
  400. INPUT "", THISZONE$ : J=VAL(THISZONE$)
  401. IF J<1 OR J>40 GOTO BadZone
  402. CLS:PRINT : PRINT TAB(5) "Back to duping and counting...";
  403. RETURN
  404. '
  405. '  Subroutine to determine prefix from portable designator
  406. '
  407. GetPortPrefix:
  408.  
  409. MARK=INSTR(THISENTRY$,SLANT$)
  410. IF MARK>3 THEN THISPFX$=RIGHT$(THISENTRY$,LEN(THISENTRY$)-MARK) ELSE THISPFX$=LEFT$(THISENTRY$,MARK-1)
  411. IF LEN(THISPFX$)>1 GOTO ReturnPfx ' have prefix - return
  412. IF ASC(THISPFX$)>58 OR ASC(THISPFX$)<47 THEN THISPFX$=LEFT$(THISENTRY$,4) : GOTO ReturnPfx ' (local portable designator)
  413. K=2 ' find position of first numeral in call
  414. WHILE (ASC(MID$(THISENTRY$,K,1))>57 OR ASC(MID$(THISENTRY$,K,1))<48) AND K<LEN(THISENTRY$)
  415.   K=K+1
  416. WEND
  417. THISPFX$=LEFT$(THISENTRY$,K-1)+THISPFX$ ' new prefix = portable number
  418.                                         ' in old prefix
  419. ReturnPfx:                                        
  420. RETURN
  421. '
  422. '  Subroutine to search prefix library for standard country prefix
  423. '  AND continent
  424. '
  425. SearchPrefix:
  426.  
  427. K=4 : INLIST=NOT TRUE : SAVEDPFX$=THISPFX$
  428. WHILE K>0 AND INLIST=NOT TRUE
  429.   THISPFX$=LEFT$(THISPFX$,K)
  430.   LOW=1 : HIGH=TABLESIZE : INLIST=NOT TRUE ' initial values for
  431.                                            ' binary sort
  432.   WHILE LOW<=HIGH AND INLIST=NOT TRUE
  433.     L=(LOW+HIGH)\2
  434.     IF THISPFX$=PFX$(L) THEN INLIST=TRUE : THISCTRY$=CTRY$(L) : THISCNT$=CNT$(L)
  435.     IF THISPFX$<PFX$(L) THEN HIGH=L-1 ELSE LOW=L+1
  436.   WEND
  437.   K=K-1
  438. WEND
  439. RETURN
  440. '
  441. '  Subroutine to search unusual prefix list 
  442. '
  443. SearchWierd:
  444.  
  445. IF NRWIERDPFX=0 GOTO GetPrefix ' if the supplementary prefix list is
  446.                                ' empty, skip ahead
  447. K=4
  448. WHILE K>0
  449.   SAVEDPFX$=LEFT$(SAVEDPFX$,K)
  450.   FOR J=1 TO NRWIERDPFX
  451.     IF SAVEDPFX$=WIERDPFX$(J) THEN INLIST=TRUE : THISCTRY$=WIERDCTRY$(J) : THISCNT$=WIERDCNT$(J) : J=NRWIERDPFX : K=1
  452.   NEXT J
  453.   K=K-1
  454. WEND
  455. IF INLIST THEN RETURN ' if the prefix was found, return
  456. '
  457. '  Routine to get prefix definition and continent from user for
  458. '  prefix NOT found in LIBRARY
  459. '
  460. GetPrefix:
  461.  
  462. CLS:PRINT CHR$(7) : PRINT
  463. PRINT TAB(5) "The prefix for ";:COLOR 3:PRINT THISENTRY$;
  464. COLOR 1:PRINT " can't be found in the prefix library."
  465. PRINT : PRINT TAB(8) "What is the callsign prefix?  "; 
  466. INPUT "", HELDPFX$:HELDPFX$=UCASE$(HELDPFX$)
  467. PRINT : PRINT TAB(8) "What standard prefix is that equivalent to?  ";
  468. INPUT "", THISPFX$:THISPFX$=UCASE$(THISPFX$)
  469. GOSUB SearchPrefix : IF NOT INLIST GOTO GetPrefix
  470. NRWIERDPFX=NRWIERDPFX+1 : WIERDPFX$(NRWIERDPFX)=HELDPFX$
  471. WIERDCTRY$(NRWIERDPFX)=THISCTRY$ : WIERDCNT$(NRWIERDPFX)=THISCNT$
  472. PRINT
  473. RETURN
  474. '
  475. '  Subroutine to resolve ambiguous prefix with user interaction
  476. '
  477. ResolvePrefix:
  478.  
  479. THISCTRY$=RIGHT$(THISCTRY$,LEN(THISCTRY$)-1) ' strip initial delimiter
  480. J=0
  481. WHILE LEN(THISCTRY$)>0
  482.   J=J+1
  483.   MARK=INSTR(THISCTRY$,".")
  484.   AMBCTRY$(J)=LEFT$(THISCTRY$,MARK-1) ' put multipiler name into array
  485.   THISCTRY$=RIGHT$(THISCTRY$,LEN(THISCTRY$)-MARK)
  486. WEND
  487. CLS : PRINT CHR$(7) : PRINT
  488. PRINT TAB(5) "The prefix for ";:COLOR 3 : PRINT THISENTRY$; 
  489. COLOR 1 : PRINT" could indicate several different countries."
  490. PRINT : PRINT TAB(8) "The possiblities are:" : COLOR 3 : PRINT
  491. FOR K=1 TO J
  492.   PRINT TAB(11) STR$(K); ". "; AMBCTRY$(K) ' print choices to screen
  493. NEXT K
  494. COLOR 1
  495.  
  496. EnterCountry:
  497.  
  498. PRINT : PRINT TAB(8) "Type the number of the correct country. > ";
  499. INPUT "", CHOICE$
  500. K=VAL(CHOICE$) : IF K > J OR K < 1 THEN PRINT CHR$(7); : GOTO EnterCountry
  501. THISCTRY$=AMBCTRY$(K)
  502. CLS : PRINT : PRINT TAB(5) "Back to duping and counting...";
  503. RETURN
  504. '
  505. '  Subroutine to print log sheet header
  506. '
  507. PrintHeader:
  508.  
  509. PRINT #2, "   "; MYCALL$; "  "; BAND$; " MHz Log";  TAB(72); "Page"; STR$(RAWTOTAL\50+1)
  510. PRINT #2, "   Date    Time   Callsign        Sent    Rcvd    New Zone   New Country   Pt."
  511. PRINT #2, " "; STRING$(78,45)
  512. THEDATE$=STR$(DAY)+MON$
  513. RETURN 
  514. '
  515. '  Subroutine to print log sheet footer
  516. '
  517. PrintFooter:
  518.  
  519. IF RAWTOTAL MOD 50=0 GOTO PrintTotals ' if at the end of a page, jump ahead
  520. FOR J=1 TO 50-(RAWTOTAL MOD 50)
  521.   PRINT #2, BL$
  522. NEXT J ' fill last page with blank lines
  523.  
  524. PrintTotals:
  525.  
  526. PRINT #2, " "; STRING$(78,45)
  527. PRINT #2, "    Totals for this page:  Valid QSOs - ";
  528. PRINT #2, USING FOOTFORM$; PGQSOS; PGZONES; PGCTRY; PGPTS
  529. PRINT #2, CHR$(12)
  530. PGQSOS=0 : PGZONES=0 : PGCTRY=0 : PGPTS=0 ' reset page counts
  531. RETURN
  532.